//=============================================================================
///	Test
//=============================================================================

#include "mlisp.h"
#include "sexp.h"
#include "ssym.h"
#include "sstring.h"
#include "senv.h"
#include "sstream.h"
#include "smem.h"
#include "seval.h"
#include "s_read.h"
#include "mio.h"
#include "mhash.h"
#include "mstring.h"
#include "mfpnum.h"

#ifndef	FALSE
#define	FALSE	(0)
#define	TRUE	(1)
#endif


const int DEFAULT_HEAP_SIZE = 16 * 1024 * 1024;


#include "sutil.h"
#include <stdlib.h>
#include <stdarg.h>
#include <setjmp.h>

extern "C" SExp current_eval_exp;
static jmp_buf s_jmp;

static void dump_current_info(void) {
	SExp s = current_eval_exp;
	if (cons_extp(s)) {
		ReadCell* p = (ReadCell*)&s.ptr->cell;
		format(sstderr, "~a(~d): ", NULL, p->filename, fixnum2s(p->lineno));
	}
}

static void put_error_info(const char* msg, va_list ap) {
	dump_current_info();
	format(sstderr, msg, &ap);
	write_cstr("\n", sstderr);
}

static SExp on_error1(const char* msg, ...) {
	va_list ap;
	va_start(ap, msg);
	put_error_info(msg, ap);
	va_end(ap);

	exit(-1);
}

static SExp on_error2(const char* msg, ...) {
	va_list ap;
	va_start(ap, msg);
	put_error_info(msg, ap);
	va_end(ap);

	fprintf(stderr, "type ':c' to continue with last value, ':e' to exit to toplevel, ':q' to quit\n");
	// debug loop
	{
		SExp e = nil;
		for (;;) {
			SExp s;
			printf(">> ");
			s = read(sstdin);
			if (eq(s, intern(":e")))	break;
			if (eq(s, intern(":c"))) {
				return e;
			}
			if (eq(s, intern(":q"))) {
				exit(1);
			}

			e = eval(s);
			write(e, sstdout, TRUE);
			write_cstr("\n", sstdout);
		}
	}

	reset_env_to_top();
	longjmp(s_jmp, 1);
}


/// Read-eval-print-loop
static void repl() {
	printf("type ':q' to quit\n");
	sexp_set_error_callback(on_error2);
	for (;;) {
		if (setjmp(s_jmp) == 0) {
			for (;;) {
				SExp s, e;
				printf("> ");
				s = read(sstdin);
				push_stack(s);
				if (eq(s, intern(":q")) || eq(s, sEOF))	break;
				pop_stack(1);

				e = eval(s);
				write(e, sstdout, TRUE);
				write_cstr("\n", sstdout);
			}
			break;
		}
	}
}


static int exec_script(const char* script_fn, int argc, char* argv[]) {
	int res = FALSE;
	sexp_set_error_callback(on_error1);
	if (setjmp(s_jmp) == 0) {
		push_stack(nil);
		for (int i=0; i<argc; ++i) {
			push_stack(gen_str(argv[i], -1));
			cons_on_stack();
		}
		setq(intern("$0"), gen_str(script_fn, -1));
		setq(intern("*args*"), nreverse(pop_stack(1)));

		SExp r = load_exec(script_fn);
		if (!nilp(r))	res = TRUE;
	}
	return res;
}

struct Option {
	int heap_size;
	int raise_gc;
};

static int parse_opt(Option* opt, int argc, char* argv[]) {
	opt->heap_size = DEFAULT_HEAP_SIZE;
	opt->raise_gc = -1;

	for (int i=1; i<argc; ++i) {
		const char* p = argv[i];
		if (*p != '-') {
			return i;
		}
		switch (p[1]) {
		default:	break;
		case 'h':
			++i;
			opt->heap_size = atoi(argv[i]);
			break;
		case 'g':
			++i;
			opt->raise_gc = atoi(argv[i]);
			break;
		}
	}
	return argc;
}


int main(int argc, char* argv[]) {
	Option opt;
	int argi = parse_opt(&opt, argc, argv);

	void* heap;
	heap = malloc(opt.heap_size);
	if (heap == NULL) {
		fprintf(stderr, "can't allocate heap: size=%d\n", opt.heap_size);
		return -1;
	}

	smem_init(heap, opt.heap_size, mlisp_gc);
	sexp_new();

	init_mlisp();
	define_io_module();
	define_hash_module();
	define_string_module();
	define_fpnum_module();

#ifdef _DEBUG
	if (opt.raise_gc >= 0) {
		int cnt = smem_get_alloc_count();
		smem_set_raise_gc(cnt + opt.raise_gc);
	}
#endif

	if (argi >= argc) {
		repl();
	} else {
		const char* fn = argv[argi];
		exec_script(fn, argc-argi-1, &argv[argi+1]);
	}

	sexp_set_error_callback(NULL);
	term_mlisp();
	sexp_delete();

	free(heap);

	return 0;
}
